{Updated 3/26/92 - USGS map making macros- CCondit}
Macro 'Set Foreground Color ---------- [F1]';
var
  Color1:integer;
Begin
  Color1:=GetNumber('Enter DN value of foreground color',255)
  SetForegroundColor(Color1)
end;
---------
Macro 'Set Background Color ---------- [F2]';
var
  Color2:integer;
Begin
  Color2:=GetNumber('Enter DN value of background color',0)
  SetBackgroundColor(Color2)
end;
-------
Macro 'Density Slice One DN value ------[F3]';
{Highlights in red all pixels of one chosen DN-value used to locate units within map image }
var
  value:integer;
Begin
  value:=GetNumber('Enter your density slice DN value',1);
  SetDensitySlice(value,value)
End;
----
Macro 'Density Slice Min-Max DN values [F4]';
{Highlights in red all pixels between (and including) two chosen DN-values to locate units between those DN-values within map image}
var
  value1,value2:integer;
Begin
  value1:=GetNumber('Enter your minimum density slice DN value',1);
  value2:=GetNumber('Enter your maximum density slice DN value',1);
  SetDensitySlice(value1,value2)
End;
------
Macro 'Pixel Count One DN value -------[F5]';
{Highlights & counts pixels for one DN-value; can be used with calibrated image to obtain the area of that unit within map image.  Measurements can be stored as ASCII files on disk -  use 'Save As' option when Measurements Window is open.-Applies change to boxes <2048 Samples wide across image up to 10,239 S wide}
var
  Newleft,left,top,width,height,wk1,counter,reps,lastwidth:integer;
  value,nopixels:integer;
  wk3:real;
Begin
  MeasureArea(true);
  MeasureMinMax(true);
  MeasureDensity(true);
  value:=GetNumber('Enter DN value to count',1);
  SetDensitySlice(value,value)
  left:=0
  top:=0
  counter:=1
  GetPicSize(width,height)
  if width<=2048 then begin
    Measure
    nopixels:=Histogram[value]
    Exit;
  end;
  wk3:=width/2048
  wk1:=Trunc(wk3)
  reps:=wk1+1
  PutMessage('Pixel Count will include more than one of the last several lines in the Measurements File');
  wk1:=wk1*2048
  lastwidth:=width-wk1
  width:=2048
  MakeRoi(left,top,width,height)
  Measure
  nopixels:=Histogram[value]
  counter:=counter+1{counter=2}
{---done 1st 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Measure
    nopixels:=Histogram[value]
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  Measure
  nopixels:=Histogram[value]
  counter:=counter+1{counter=3}
{---done 2nd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Measure
    nopixels:=Histogram[value]
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  Measure
  nopixels:=Histogram[value]
  counter:=counter+1{counter=4}
{---done 3rd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Measure
    nopixels:=Histogram[value]
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  Measure
  nopixels:=Histogram[value]
  counter:=counter+1{counter=5}
{---done  4th 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Measure
    nopixels:=Histogram[value]
    KillRoi;
    Exit;
  end;
  PutMessage('Macro limit is 10239 samples!')
end;
-------
Macro 'Pixel Count Min-Max DN values -[F6]';
{Highlights & counts the number of pixels between (and including) two chosen DN-values;  see notes in F5 above}
var
  i,value1,value2,totalpixels:integer;
Begin
MeasureArea(true);
MeasureMinMax(true);
MeasureDensity(true);
  value1:=GetNumber('Enter your minimum DN value for count',1);
  value2:=GetNumber('Enter your maximum DN value to count',255);
  SetDensitySlice(value1,value2)
  Measure
 totalpixels:=0
  For i:=value1 to value2 do begin
    totalpixels:=totalpixels+Histogram[i]
   end;
End;
---------
Macro 'Select Rectangular Area --------[F7]';
var
  left,top,width,height:integer;
Begin
  left:=GetNumber('Enter Starting Sample of box',0)
  top:=GetNumber('Enter Starting Line of box',0)
  width:=GetNumber('Enter No. of Samples (width) of box',2048)
  height:=GetNumber('Enter No. of Lines (height) of box',1024)
  MakeRoi(left,top,width,height)
end;
-------
Macro 'Change 1 DN value -------------[F8]';
var
  InputDN1,OutputDN:integer;;
Begin
  InputDN1:=GetNumber('Enter DN-value to change',255)
  OutputDN:=GetNumber('Enter target DN-value',0)
  ChangeValues(InputDN1,InputDN1,OutputDN);
end;

-------
Macro 'Change Slice of DN -------------[F9]';
var
InputDN1,InputDN2,OutputDN:integer;
Begin
  InputDN1:=GetNumber('Enter min DN-value to change',0)
  InputDN2:=GetNumber('Enter max DN-value to change',255)
  OutputDN:=GetNumber('Enter target DN-value',0)
  ChangeValues(InputDN1,InputDN2,OutputDN)
end;
-----
Macro 'Paste Clipboard at x, y -------- [F10]';
{Used to paste Clipboard contents at user-selected line (y) and sample (x) coordinates.  NOTE:  You must set the ROI (box) with the same number of lines & samples as the clipboard}
var
  width,height,StartLine,StartSample:integer;
Begin
  width:=GetNumber('Enter width (x) of clipboard',2048)
  height:=GetNumber('Enter height (y) of clipboard',1024)
  StartLine:=GetNumber('Enter Starting Line (y) for Paste',0)
  StartSample:=GetNumber('Enter Starting Sample (x)) for Paste',0)
  MakeRoi(0,0,width,height)
  MoveRoi(StartSample,StartLine)
  Paste
end;
--------
macro 'Reset Palette-GrayScale -------[F11]';
begin
  SetPalette('Grayscale')
end;
------
macro 'Reset Palette-256 Color Spect--[F12]';
begin
  SetPalette('256 Color Spectrum')
end;
----------
macro 'Add two Images -------------- [F13]';
{Also gets around temp. line length buffer limit of 2048 - see notes F5}
var
  Newleft,left,top,width,height,wk1,counter,reps,lastwidth:integer;
  wk3:real;
Begin
  ScaleMath(false);
  left:=0
  top:=0
  counter:=1
  GetPicSize(width,height)
  if width<=2048 then begin
    MakeRoi(left,top,width,height)
    Copy;
    NextWindow;
    MakeRoi(left,top,width,height)
    Paste;
    Add;
    Exit;
  end;
  wk3:=width/2048
  wk1:=Trunc(wk3)
  reps:=wk1+1
  wk1:=wk1*2048
  lastwidth:=width-wk1
  width:=2048
  MakeRoi(left,top,width,height)
  Copy;
  NextWindow;
  MakeRoi(left,top,width,height)
  Paste;
  Add;
  NextWindow;
  counter:=counter+1{counter=2}
{---done 1st 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Copy;
    NextWindow;
    MakeROI(Newleft,top,lastwidth,height)
    Paste;
    Add;
    Exit;
  end;
  MakeRoi(left,top,width,height)
  MoveRoi(2048,0)
  Copy;
  NextWindow;
  MakeRoi(left,top,width,height)
  MoveRoi(2048,0)
  Paste;
  Add;
  NextWindow;
  counter:=counter+1{counter=3}
{---done 2nd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Copy;
    NextWindow;
    MakeROI(Newleft,top,lastwidth,height)
    Paste;
    Add;
    Exit;
  end;
  MakeRoi(left,top,width,height)
  MoveRoi(4096,0)
  Copy;
  NextWindow;
  MakeRoi(left,top,width,height)
  MoveRoi(4096,0)
  Paste;
  Add;
  NextWindow;
  counter:=counter+1{counter=4}
{---done 3rd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Copy;
    NextWindow;
    MakeROI(Newleft,top,lastwidth,height)
    Paste;
    Add;
    Exit;
  end;
  MakeRoi(left,top,width,height)
  MoveRoi(6144,0)
  Copy;
  NextWindow;
  MakeRoi(left,top,width,height)
  MoveRoi(6144,0)
  Paste;
  Add;
  NextWindow;
  counter:=counter+1{counter=5}
{---done  4th 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    Copy;
    NextWindow;
    MakeROI(Newleft,top,lastwidth,height)
    Paste;
    Add;
    Exit;
  end;
  PutMessage('Macro limit is 10239 samples!')
end;
------
macro 'Measure Perimeter & Area -----[F14]';
{
}
var
  value,nopixels:integer;
Begin
  value:=GetNumber('Enter DN value of unit to measure',1);
  SetDensitySlice(value,value)
WandAutoMeasure(true);
MeasureArea(true);
MeasureMinMax(true);
MeasureDensity(true);
AdjustAreas(true);
MeasurePerimeter(true)
  nopixels:=Histogram[value]
  PutMessage('Click on Wand & then unit to measure; Use Comnd-2 to see Measurements; F3 for new DN');
  PutMessage('To save Measurements Window data w/ headings select File-Export w/ Option Key down');
End;

---------
Macro 'Import & Apply LUT ------------[F15]';
{Written to also get around temp. line length buffer limit of 2048 - see notes F5}
var
  Newleft,left,top,width,height,wk1,counter,reps,lastwidth:integer;
  wk3:real;
Begin
  left:=0
  top:=0
  counter:=1
  SetImport('Palette')
  Import('')
  GetPicSize(width,height)
  if width<=2048 then begin
    ApplyLUT
    Exit;
  end;
  wk3:=width/2048
  wk1:=Trunc(wk3)
  reps:=wk1+1
  wk1:=wk1*2048
  lastwidth:=width-wk1
  width:=2048
  MakeRoi(left,top,width,height)
  ApplyLUT
  counter:=counter+1{counter=2}
{---done 1st 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    SetImport('Palette')
    Import('')
    ApplyLUT
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  SetImport('Palette')
  Import('')
  ApplyLUT
  counter:=counter+1{counter=3}
{---done 2nd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    SetImport('Palette')
    Import('')
    ApplyLUT
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  SetImport('Palette')
  Import('')
  ApplyLUT
  counter:=counter+1{counter=4}
{---done 3rd 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    SetImport('Palette')
    Import('')
    ApplyLUT
    KillRoi;
    Exit;
  end;
  MoveRoi(2048,0)
  SetImport('Palette')
  Import('')
  ApplyLUT
  counter:=counter+1{counter=5}
{---done  4th 2048}
  if counter=reps then begin
    Newleft:=((counter-1)*2048)
    MakeROI(Newleft,top,lastwidth,height)
    SetImport('Palette')
    Import('')
    ApplyLUT
    KillRoi;
    Exit;
  end;
  PutMessage('Macro limit is 10239 samples!')
end;
------
macro 'Reset Analysis Options -------/0';
{Macro included w/ Image program - Resets the Options dialog box in the Analyze menu to the default settings.}
begin
  MeasureArea(true);
  MeasureDensity(true);
  MeasureStandardDeviation(false);
  MeasureXY(false);
  MeasureMode(false);
  MeasurePerimeter(false);
  MeasureMajorAxis(false);
  MeasureMinorAxis(false);
  MeasureAngle(false);
  MeasureIntegratedDensity(false);
  Redirect(false);
  LabelParticles(true);
  OutlineParticles(false);
  IgnoreParticlesTouchingEdge(false);
  IncludeInteriorHoles(false);
  WandAutoMeasure(false);
  AdjustAreas(false);
  SetParticleSize(1,999999);
  SetPrecision(2);
end;
-----
Macro 'Histogram for 8192 sample image/7';
{Gets histogram of image and exports with prompt for file name - applies histogram to boxes <4096 samples wide across image up to 8192 S wide}
var
  Newleft,left,top,width,height,wk1,counter,reps,lastwidth:integer;
  value,nopixels:integer;
  wk3:real;
Begin
  left:=0
  top:=0
  counter:=1
  GetPicSize(width,height)
  if width<=4096 then begin
    ShowHistogram;
    export;
    Exit;
  end;
  wk3:=width/4096
  wk1:=Trunc(wk3)
  reps:=wk1+1
  PutMessage('Your values will be saved in several files that must be summed');
  wk1:=wk1*4096
  lastwidth:=width-wk1
  width:=4096
  MakeRoi(left,top,width,height)
  ShowHistogram;
  export;
  KillRoi;
  counter:=counter+1{counter=2}
{---done 1st 4096}
  if counter=reps then begin
    Newleft:=((counter-1)*4096)
    MakeROI(Newleft,top,lastwidth,height)
    PutMessage('Your2nd box histo next');
    ShowHistogram;
    Copy;
    KillRoi;
    Exit;
  end;
{  PutMessage('Macro limit is 10239 samples!')}
end;